home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr05 / ew120.zip / FILES1.ZIP / BEGINEND.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-02  |  7KB  |  257 lines
  1. {************************************************}
  2. {                         }
  3. { E! for Windows                 }
  4. { (c) - Patrick Philippot - 1992-1993         }
  5. {                         }
  6. { Sample Extension DLL - version 1.1         }
  7. {                         }
  8. { This DLL implements an extension to the     }
  9. { Check Brace function. The original function     }
  10. { doesn't take into account the BEGIN/END,       }
  11. { CASE/END or REPEAT/UNTIL pairs of the Pascal     }
  12. { language. If loaded, this DLL will extend the  }
  13. { search and find the above matching pairs.     }
  14. {                         }
  15. {************************************************}
  16.  
  17. (*
  18. To use this DLL simply load it from the user menu or add its name to the
  19. list of autoloaded Extension DLLs using the Autoload dialog box from
  20. the User Menu of EW. That's all. This extension cannot be executed because
  21. it only adds a hook to the CheckBrace function and exports no EWExecute
  22. function.
  23.  
  24. BEGINEND will check if the standard CheckBrace function failed and will try
  25. to find a BEGIN/END, CASE/END or REPEAT/UNTIL pair. BEGINEND will fail if the
  26. word at the cursor position doesn't belong to that list.
  27.  
  28. Once BEGINEND has been loaded, Ctrl H (default assignment) will trigger the
  29. CheckBrace function and pass along control to BEGINEND in case of failure.
  30.  
  31. BEGINEND works in both directions. If you set the cursor under BEGIN, CASE or
  32. REPEAT, it will search forward for END or UNTIL, otherwise if you set the
  33. cursor under UNTIL or END, it will look backward for a matching BEGIN, CASE
  34. or REPEAT.
  35.  
  36. Of course, nested pairs are ignored as well as keywords enclosed within
  37. comment braces.
  38.  
  39. BEGINEND uses the FuncExitHook provided by the EW API and some other API
  40. services giving information about the current Editor.
  41. *)
  42.  
  43. {$I compdir.inc}
  44. {$C MOVEABLE PRELOAD DISCARDABLE}
  45.  
  46. library BeginEnd;
  47.  
  48. uses WinTypes, EWApiImp, Strings;
  49.  
  50. {$I ewuser.inc}
  51.  
  52. var
  53.   SaveExit  : Pointer;
  54.   BufIndex,
  55.   LineIndex,
  56.   MaxIndex  : integer;
  57.   Len        : word;
  58.  
  59.  
  60. function SearchMatchingItem : boolean;
  61.  
  62. type
  63.   longrec = record
  64.     LoW, HiW : integer;
  65.   end;
  66.  
  67. var
  68.   newch,
  69.   ch        : char;
  70.   CommentLevel    : integer;
  71.   XYPos     : longint;
  72.   PairCount    : word;
  73.   Linebuffer    : array[0..255] of char;
  74.   bForward,
  75.   bDone     : boolean;
  76.  
  77.   function GetChar : char;
  78.  {-Retrieve characters from the text flow}
  79.   begin
  80.     if bForward then begin
  81.       Inc(BufIndex);
  82.       if BufIndex >= Len then begin
  83.     Inc(LineIndex);
  84.     if LineIndex <= MaxIndex then begin
  85.       while StrUpper(StrCopy(LineBuffer, EwGetLineAt(LineIndex)))[0] = #0 do begin
  86.         Inc(LineIndex);
  87.         if LineIndex > Maxindex then begin
  88.           GetChar := #0;
  89.           Exit;
  90.         end;
  91.       end;
  92.       Len := StrLen(LineBuffer);
  93.       BufIndex := 0;
  94.     end else begin
  95.       GetChar := #0;
  96.       Exit;
  97.     end;
  98.       end;
  99.     end else begin
  100.       Dec(BufIndex);
  101.       if BufIndex < 0 then begin
  102.     Dec(LineIndex);
  103.     if LineIndex >= 0 then begin
  104.       while StrUpper(StrCopy(LineBuffer, EwGetLineAt(LineIndex)))[0] = #0 do begin
  105.         Dec(LineIndex);
  106.         if LineIndex < 0 then begin
  107.           GetChar := #0;
  108.           Exit;
  109.         end;
  110.       end;
  111.       Len := StrLen(LineBuffer);
  112.       BufIndex := Pred(Len);
  113.     end else begin
  114.       GetChar := #0;
  115.       Exit;
  116.     end;
  117.       end;
  118.     end;
  119.     GetChar := LineBuffer[BufIndex];
  120.   end;
  121.  
  122.   function MatchPattern(ch : char) : boolean;
  123.  {-Verify if the word beginning at the cursor position match a list member}
  124.   var
  125.     MatchStr : array[0..6] of char;
  126.     MatchEnd : word;
  127.     P         : PChar;
  128.   const
  129.     Delimiters : set of char =
  130.       ['.', ' ', ',', ';', ':', '\', '/', '(', ')', '{', '}', '[', ']', '-'];
  131.   begin
  132.     MatchPattern := false;
  133.     if CommentLevel <> 0 then
  134.       Exit;
  135.     case ch of
  136.       'B' : StrCopy(MatchStr, 'BEGIN');
  137.       'R' : StrCopy(MatchStr, 'REPEAT');
  138.       'U' : StrCopy(MatchStr, 'UNTIL');
  139.       'C' : StrCopy(MatchStr, 'CASE');
  140.       'E' : StrCopy(MatchStr, 'END');
  141.     end;
  142.     MatchEnd := StrLen(MatchStr) + BufIndex;
  143.     P := StrPos(LineBuffer + BufIndex, MatchStr);
  144.     MatchPattern :=
  145.       (P <> nil)
  146.       and
  147.       (P - LineBuffer = BufIndex)
  148.       and
  149.       ((BufIndex = 0) or (LineBuffer[Pred(BufIndex)] in [' ', ';']))
  150.       and
  151.       ((MatchEnd = Len) or ((MatchEnd < Len) and (LineBuffer[MatchEnd] in Delimiters)));
  152.   end;
  153.  
  154. begin
  155.  {-Get current cursor position}
  156.   XYPos := EWGetCaretPos;
  157.   BufIndex := longrec(XYPos).LoW;
  158.   LineIndex := longrec(XYPos).HiW;
  159.  {-Get number of lines in current Editor}
  160.   MaxIndex := Pred(EWGetLineCount);
  161.  {-Get the current line}
  162.   StrUpper(StrCopy(LineBuffer, EwGetLineAt(LineIndex)));
  163.  {-Initialize search data}
  164.   Len := StrLen(LineBuffer);
  165.   CommentLevel := 0;
  166.   bDone := false;
  167.   bForward := Upcase(LineBuffer[BufIndex]) in ['B', 'C', 'R'];
  168.   if bForward then
  169.     Dec(BufIndex)
  170.   else
  171.     Inc(BufIndex);
  172.   SearchMatchingItem := false;
  173.   if not MatchPattern(GetChar) then
  174.     Exit
  175.   else
  176.     PairCount := 1;
  177.   repeat
  178.    {-Read character from text stream and update search variables}
  179.     ch := Upcase(GetChar);
  180.     case ch of
  181.       '{' : Inc(CommentLevel);
  182.       '}' : Dec(CommentLevel);
  183.       '(' : if bForward and (GetChar = '*') then
  184.           Inc(CommentLevel);
  185.       ')' : if not bForward and (GetChar = '*') then
  186.           Inc(CommentLevel);
  187.       '*' : begin
  188.           newch := GetChar;
  189.               if (bForward and (newch = ')')
  190.               or (not bForward and (newch = '('))) then
  191.         Dec(CommentLevel)
  192.         end;
  193.       'B',
  194.       'R',
  195.       'C' : if MatchPattern(ch) then
  196.           if bForward then
  197.         Inc(PairCount)
  198.           else
  199.         Dec(PairCount);
  200.       'U',
  201.       'E' : if MatchPattern(ch) then
  202.           if bForward then
  203.         Dec(PairCount)
  204.           else
  205.         Inc(PairCount);
  206.     end;
  207.     if PairCount = 0 then begin
  208.    {-Nesting level returned to 0. A matching sequence has been found}
  209.       SearchMatchingItem := true;
  210.       EWGotoXY(BufIndex, LineIndex);
  211.       bDone := true;
  212.     end;
  213.   until bDone or (ch = #0);
  214.  {-See comments in FunctionExitHook}
  215.   if not bDone then
  216.     EWWriteMessage('No matching sequence found')
  217.   else
  218.     EWWriteMessage(''); {-Clear previous error messages}
  219.   SearchMatchingItem := bDone;
  220. end;
  221.  
  222. function FuncExitHook(command : word; pRetCode : PInteger) : integer; export;
  223. {-Check whether the CheckBrace function succeeded.}
  224. { If not, call SearchMatchingItem}
  225. begin
  226.   FuncExitHook := 0;
  227.  {-Although the present version of the EW API doesn't check the return code}
  228.  { from the FuncExitHook functions, it is good practice to set this value  }
  229.  { to 0.}
  230.   if (command = ew_CheckBrace) and (pRetcode^ <> 0) then
  231.     if SearchMatchingItem then
  232.       pRetcode^ := 0 {-Success. Overwrite error code returned by CheckBrace}
  233.     else
  234.       pRetcode^ := ewerr_EXTFAILED; {-Unique exit code signaling that the}
  235.                     { extension function failed.}
  236.   {-You may also leave pRetcode^ unchanged and let EW display its usual }
  237.   { message. In that case EW would issue no message at all, so it's pre-}
  238.   { ferable to handle this ourselves.}
  239.  
  240. end;
  241.  
  242. procedure LibExit; far;
  243. begin
  244.   EWRemoveHook(EWHook_FunctionExit, @FuncExitHook);
  245.   ExitProc := SaveExit;
  246. end;
  247.  
  248. exports
  249.   FuncExitHook     index 1;
  250.  
  251. begin
  252.   EWSetHook(EWHook_FunctionExit, @FuncExitHook);
  253.   SaveExit := ExitProc;
  254.   ExitProc := @LibExit;
  255. end.
  256. 
  257.